perm filename LINES.FAI[NEW,LCS]2 blob
sn#251316 filedate 1977-03-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE LINES
C00026 ENDMK
C⊗;
TITLE LINES
ENTRY LINES,EDIT
EXTERNAL .COMM.,ALF,RRJJ,SC,LPEN,MVBEAM,SCANR,UPDWN
EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT
DEFINE FIXX(N)
< KIFIX N,N ↔ >
KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
; SUBROUTINE LINES(A,B,L)
; COMMON/DST/BB,CC
; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
; 1,(JJ2,JJ(2))
; DATA BB/.008/,CC/3.5/
;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
M←2 ↔ N←3 ↔ K←4
LINES: 0 ; GO TO 23
DIST1: JRST L23 ;22 IF(JQ(1).NE.0)GO TO 23
SKIPE PLTR+=27
JRST L23 ; IF(CC.EQ.1000)GO TO 23
DIST: MOVSI T,212764
CAMN T,DST+1 ;** FOR DISTORATION -- SEE ALSO FILLMS ***
JRST L23 ; B=B*(CC-BB*ABS(A))
MOVM T,@(16)
FMPR T,DST ;BB IS DST, CC IS DST+1
FSBR T,DST+1
FMPRM T,@1(16)
MOVNS @1(16)
L23: MOVE M,@(16) ;23 IF(IPLT)GO TO 2
FMPR M,SIZ ; M=A*RSZ
KIFIX M,M ; N=B*RSZ
MOVE N,@1(16)
FMPR N,SIZ
KIFIX N,N ; IF(RSZ.LE.0.8571)GO TO 3
MOVE T,[=0.8571]
CAML T,SIZ
;; JRST L3
JRST L6
SUB M,SIZ+1 ; M=M-JCEN
SUB N,SIZ+2 ; N=N-KCEN
; IF(JA.NE.8)GO TO 5
MOVEI T,10
CAME T,.COMM.+1
JRST L5 ; IF(M.GT.511)M=511
CAMLE M,[=511]
HRRZI M,=511 ; IF(M.LT.-511)M=-511
CAMGE M,[-=511]
HRROI M,-=511 ;5 IF(IABS(M).GT.512)GO TO 77
L5: CAIG M,=512
CAMGE M,[-=512]
JRST L77 ; IF(IABS(N).LT.512)GO TO 4
CAIGE N,=512
CAMG N,[-=512]
CAIA
JRST LL4 ;77 KZ=-1
L77: SETOM KZ# ; RETURN
JRA 16,3(16) ;4 IF(KZ.EQ.0)GO TO 6
LL4: SKIPN KZ
JRST L6 ; KZ=0
SETZM KZ
MOVEM M,MM# ; GO TO 1
MOVEM N,NN#
JRST L1 ;3 IF(JA.EQ.44)GO TO 6
;6 IF(JJ2.GT.3990)RETURN
L6: MOVEI T,7626
CAMGE T,DPY+1
JRA 16,3(16) ; IF(L.EQ.3)GO TO 1
MOVEM M,MM
MOVEM N,NN
HRRZI T,3
CAMN T,@2(16)
JRST L1 ; CALL AVECT(M,N)
JSA 16,AVECT
JUMP MM
JUMP NN ; RETURN
JRA 16,3(16) ;1 CALL AIVECT(M,N)
L1: JSA 16,AIVECT
JUMP MM
JUMP NN ; RETURN
JRA 16,3(16) ;2 IF(IPLT.EQ.-2)RETURN
;;L2: MOVNI T,2
;; CAMN T,PLTR
;; JRA 16,3(16)
EDIT: 0 ; 00100 SUBROUTINE EDIT(JJA)
; 00200 COMMON/ALF/INP(72),ML /UPDWN/ RL,UD
; 00300 COMMON /SC/JL,LJ,MK
;00400 1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JM,JN,DBST,NFLG,IXX,ISEMI,QQ
; 00500 1 ,RVX(50),IAMP,A,RRN,B,MODE,IBLA
; 00600 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; 00700 COMMON/RRJJ/RJJ2,RJJ(20)
;00800 EQUIVALENCE (RVX1,RVX(1)),(RVX2,RVX(2)),(RVX4,RVX(4))
;00900 1,(RVX3,RVX(3)),(RJ6,RJJ(4)),(RJ9,RJJ(7)),(R3,RJQ(1))
;01000 1,(RJ5,RJJ(3)),(RJ10,RJJ(8)),(INP2,INP(2)),(INP20,INP(20))
DEFINE JN<SC+=10> ↔ DEFINE ML <ALF+=72> ↔ DEFINE JA <.COMM.+1>
DEFINE R2<.COMM.> ↔ DEFINE RJJ2<RRJJ> ↔ DEFINE UD <UPDWN+1>
DEFINE RVX1<SC+=16> ↔ DEFINE RVX2<SC+=17> ↔ DEFINE RVX3<SC+=18>
DEFINE RVX4<SC+=19> ↔ DEFINE RJ6<RRJJ+4> ↔ DEFINE RJ5<RRJJ+3>
DEFINE RJ9<RRJJ+=7> ↔ DEFINE RJ10<RRJJ+=8> ↔ DEFINE R3<.COMM.+4>
DEFINE RJ8<RRJJ+=6> ↔ DEFINE RJ7<RRJJ+=5>
DEFINE INP2<ALF+1> ↔ DEFINE INP20<ALF+=19> ↔ DEFINE ISEMI<SC+=14>
DEFINE RL<UPDWN> ↔ DEFINE RJJ <RRJJ+1>
; 01100 JN=-1
SETOM JN
MOVE @(16)
MOVEM JJA# ; 01200 C THIS IS FLAG IN SCANR
; 01300 INP20=ISEMI
MOVE 02,ISEMI
MOVEM 02,INP20 ;1400 C SETS LIMIT IN SCANR
; 01500 ML=1
MOVEI 02,1
MOVEM 02,ML ;1600 RVX2=0
SETZM RVX2 ; 01700 RVX4=0
SETZM RVX4
;01800 C E=EDIT(55), C=COPY(2222), X=EXIT(222), DE=DEL(99), LP=LTPN
; 01900 CALL SCANR
JSA 16,SCANR ; 02000 JN=0
SETZM JN ;2100 R2=RVX2
MOVE 3,RVX2
MOVEM 3,R2 ; 02200 IF(RVX1.GT.10.)GO TO 7
MOVSI 02,204500
CAMGE 02,RVX1
JRST E7 ;2300 JA=0
SETZM JA
SETZ 0, ; FOR E8
; 02400 IF(RVX2.NE.0)GO TO 8
JUMPN 3,E8 ; 02500 IF(INP2.EQ.'P')GO TO 5
MOVE 02,[501004020100]
CAMN 02,INP2
JRST E5 ; 02600 RVX2=RL
MOVE 02,RL ; 02700 IF(RVX1.GT.2)RVX2=UD
MOVSI 202400
CAMGE RVX1
MOVE 02,UD
MOVEM 02,RVX2 ;2800 C STORES RT-LFT OR UP-DOWN INFO
; 02900 GO TO 8
JRST E8 ;3200 C FOR LIGHT PEN MOVING
E7: KIFIX 0,RVX1 ;MOVE RVX1 03300 7 JA=RVX1
MOVEM 00,JA
CAIN =99 ;03400 IF(JA.EQ.99)R2=0
SETZM R2
; 03500 IF(R2.NE.0)RETURN
SKIPE R2
JRA 16,1(16)
CAIE =55 ;03600 IF(JA.NE.55)RETURN
JRA 16,1(16)
; 03700 5 CALL LPEN(R3,R2,K)
E5: JSA 16,LPEN
JUMP R3
JUMP R2
JUMP 00,2 ; 2 IS A DUMMY HERE
; 03800 C ↑↑↑ K NOT USED!
;03900 CURSOR WILL FIND HORZ POS FOR 55 EDIT.(R3=STF,R2=HORZ) SEE 554 IN MAIN.
; 04000 IF(JA.EQ.0)CALL EXCH(R2,R3)
MOVE 0,JA
JUMPN 0,.+4
MOVE 2,R2
EXCH 2,R3
MOVEM 2,R2
; 04100 RVX1=2.
MOVSI 02,202400
MOVEM 02,RVX1
; 04200 RVX2=R3-RJJ(1)
MOVE 02,R3
FSBR 02,RJJ
MOVEM 02,RVX2
; 04300 RVX3=3.
MOVSI 02,202600
MOVEM 02,RVX3
; 04400 RJQ(2)=0
SETZM .COMM.+5 ; R4
; 04500 RJJ2=R2
MOVE 02,R2
MOVEM 02,RJJ2
; 04700 C SO JD WILL BE 0 IN MAIN PROG.
; 04800 C FOR EDIT MODE
E8: CAIN =55 ; 04900 8 IF(JA.EQ.55)RETURN
JRA 16,1(16)
; 05000 IF(INP2.EQ.'P')GO TO 17
MOVE 02,[501004020100]
CAMN 02,INP2
JRST E17
; 05100 IF(RVX1.GT.2)GO TO 117
MOVSI 02,202400
CAMGE 02,RVX1
JRST E117
; 05200 RL=RVX2
MOVE 02,RVX2
MOVEM 02,RL
SKIPE 2,RVX4 ; 05300 IF(RVX4.NE.0)UD=RVX4
MOVEM 02,UD
; 05400 GO TO 17
JRST E17
; 05500 117 IF(RVX4.NE.0)RL=RVX4
E117: MOVE 02,RVX4
JUMPE 02,.+3
MOVE 02,RVX4
MOVEM 02,RL
; 05600 UD=RVX2
MOVE 02,RVX2
MOVEM 02,UD
; 05700 17 R2=.00001
E17: MOVE 02,[0.00001]
MOVEM 02,R2
; 05800 JA=0
SETZM JA
KIFIX 1,RVX1 ;MOVE 1,RVX1 ; 5900 K=RVX1
;; MOVEM 00,K
; 06000 857 GO TO (1,2,3,4,2),K
;;E857: SKIPLE 1
;; CAILE 01,5
;; SKIPA 0
MOVE 7,JJA ; KEEP CODE NUM IN AC0
E857: JUMPLE 1,E1 ; IF(K.LE.0)K=1
CAIL 1,5
JRST E2 ; IF(K.GE.5)GO TO 2 -- CATCHES SOME ERRORS.
E855: JRST @E855 (1)
JUMP 00,E1
JUMP 00,E2
JUMP 00,E3
JUMP 00,E4
E4: MOVNS 00,RVX2 ; 06100 4 RVX2=-RVX2
E3: CAIE 7,4
JRST .+5 ; SKIP IF NOT CODE 4
SKIPN RJ6 ;06300 SKIP OVER CLEFS (JJA=3) IS NOW REMOVED. 6/73
SKIPE RJ5 ; 06400 3 CALL MVBEAM(RJJ,0,2,2,RVX2)
SKIPA
JRST E856 ; IGNORE BAR LINES -- IF(R5.EQ.0.AND.R6.EQ.0)GO TO 856
JSA 16,MVBEAM
JUMP RJJ
JUMP [0] ;MVBEAM USES AC0→6
JUMP [2]
JUMP [2]
JUMP RVX2
; 06500 C MOVES UP AND DOWN. HANDLES MINIS, ETC.
; ; 06600 IF(JJA.LT.4)GO TO 856
CAIGE 7,4
JRST E856
CAILE 7,6 ; 06700 IF(JJA.GT.6)GO TO 856
JRST E856
; 06800 C I THINK R2 MUST BE NON-ZERO TO WORK IN EDIT MODE?
; 06900 12 IF(RJ5.EQ.50)GO TO 856
MOVSI 02,206620
CAMN 02,RJ5
JRST E856
; 07000 C 50=CRESC.-DECRESC.
; 07300 RJ5=RJ5+RVX2
MOVE 02,RVX2
FADRM 02,RJ5
; 07400 C MOVES 5TH PARAM UP OR DOWN
JRST E856 ; 07500 GO TO 856
; 07600 1 RVX2=-RVX2
E1: MOVNS 00,RVX2
; 07700 2 R2=RVX2
E2: MOVE 02,RVX2
MOVEM 02,R2
; 07800 856 IF(RVX4.EQ.0)GO TO 858
E856: MOVE 3,RVX4
JUMPE 3,E858
KIFIX 1,RVX3 ;MOVE 1,RVX3 07900 K=RVX3
; 08000 RVX2=RVX4
MOVEM 3,RVX2
; 08100 RVX4=0
SETZM RVX4
; 08200 GO TO 857
JRST E857
; 08300 858 IF(R2.EQ..00001)GO TO 7515
E858: MOVE 2,R2
CAMN 2,[0.00001]
JRST E7515 ; 1 HAS R2
; 08400 IF(JJA.LT.5)GO TO 477
CAIGE 7,5
JRST E477
CAIG 7,=8 ; 08500 IF(JJA.LE.8)GO TO 5515
JRST E5515
E477: CAIE 7,4 ; 08600 477 IF(JJA.NE.4)GO TO 7515
JRST E7515
SKIPN RJ6 ; 08700 IF(RJ6.EQ.0)GO TO 7515
SKIPE RJ5 ; CHANGED↑↑↑ TO IF(RJ6.EQ.0.AND.RJ5.EQ.0)
SKIPA ;RARE CASES MIGHT BE FOUND! USING P7≠0
JRST E7515
; ; 08800 C ABOVE FOR P1=6 (BEAMS, SLURS, LINES)
E5515: SKIPE RJ6 ;IF(RJ6.EQ.0)SKIP //GO BACK (UP-DOWN)5515 RJ6=RJ6+R2
FADRM 2,RJ6
CAIN 7,6 ; 09000 IF(JJA.NE.6)GO TO 7515
SKIPN RJ9 ; 09100 IF(RJ9.EQ.0)GO TO 7515
JRST E7515
;; MOVE RJ10 ; 09200 IF(RJ10.NE.0)GO TO EDX1
;; CAML [30.0]
MOVE RJ7
JUMPG ERJ8 ;IF(R7. AND. R9.NE.0) MOVE R9
SKIPLE RJ9
JRST E7515-1
ERJ8: SKIPLE RJ8 ;IF(R8.GT.0) MOVE R8
FADRM 2,RJ8
;; JUMPN E7515-1
;; SKIPN RJ8 ; IF(RJ8.NE.0)GO TO E7515-1
;; SKIPGE RJ7 ; IF(RJ7.GE.0))GO TO E7515
SKIPLE RJ9
FADRM 2,RJ9 ; 09300 RJ9=RJ9+R2
;09400 RJ9(P9) IS LOC. OF INNER NOTE IN BEAM RANGE. SKIPS NUMBERS IN P9.
; 09500 7515 RJJ(1)=R2+RJJ(1)
E7515: FADRM 2,RJJ
JRA 16,1(16) ; 09600 END
END